home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
QRZ! Ham Radio 8
/
QRZ Ham Radio Callsign Database - Volume 8.iso
/
pc
/
files
/
mac
/
proj_a1.hqx
/
Project Mac - A1
/
MacMiniMUF.basic
(
.txt
)
< prev
next >
Wrap
AmigaBASIC Source Code
|
1987-07-20
|
9KB
|
299 lines
' Sun Jul 19, 1987 (2230)
' MacMiniMUF
' Based on MINIMUF3.5 (Rose, QST, Dec.1982, pp 36-38.)
' Modified for Macintosh by J.S. Weaver, KA2OVS
' (5 Sayles St., Alfred, NY 14802)
' All commercial rights reserved.
DEF FNSS(F)=-94.43+F*(1.6031+F*(-0.002189+5.20244e-315*F))
DEF FNFlux(S)=64.2+S*(0.7343+0.000829*S)
DIM MUF(24),Rect%(3)
GOSUB SetUp
ON MENU GOSUB DoMenu
MENU ON
ON <0x43,0x07> GOSUB DoDialog
<0x43,0x07> ON
Idle: ' Main idle loop
GOTO Idle
DoMenu: ' Menu handler
Nmenu=MENU(0)
IF Nmenu<>1 GOTO Nope
Nitem=MENU(1)
ON Nitem GOTO DoHelp,Nope,DoQuit
Nope: ' Invalid choices land here
MENU
RETURN
DoHelp: ' Help screen page 1
MENU
WINDOW 2
WINDOW OUTPUT 2
Page%=1
CALL Helper(Page%)
RETURN
DoQuit: ' Exit program
MENU
END
DoDialog: ' Dialog handler
Act=<0x43,0x07>(0)
ON Act GOTO DoButton,NewField,Nada,Nada,Nada,DoRet,DoTab
Nada: ' Invalid choices land here
RETURN
DoButton:
Nbutton=<0x43,0x07>(1)
IF Nbutton=1 THEN ' "GO" button
GOTO DoCalcs
ELSEIF Nbutton=2 THEN ' "SSN" button
Bflag=2
<0x40,0x07> 2,2
<0x40,0x07> 3,1
ELSEIF Nbutton=3 THEN ' "Flux" button
Bflag=3
<0x40,0x07> 2,1
<0x40,0x07> 3,2
ELSEIF Nbutton=4 THEN ' "Quit" button
END
ELSEIF Nbutton=5 THEN ' "More" button
Page%=Page%+1
IF Page%>2 THEN Page%=1
CALL Helper(Page%)
ELSEIF Nbutton=6 THEN ' "OK" button
WINDOW 1
WINDOW OUTPUT 1
CALL <0x13,0x07>(VARPTR(Rect%(0)))
END IF
RETURN
NewField: ' Moved to new edit field
Efield=<0x43,0x07>(2)
GOSUB DoFlux ' Update SSN or Flux
RETURN
DoRet:
IF WINDOW(0)=1 THEN GOTO DoCalcs ' Main screen <Return>
IF WINDOW(0)=2 THEN ' Help screen <Return>
WINDOW 1
WINDOW OUTPUT 1
CALL <0x13,0x07>(VARPTR(Rect%(0)))
END IF
RETURN
DoTab: ' Tab to next edit field
IF Efield<8 THEN Efield=Efield+1 :ELSE Efield=1
IF Bflag=2 AND Efield=4 THEN Efield=5
IF Bflag=3 AND Efield=3 THEN Efield=4
GOSUB DoFlux
RETURN
DoCalcs: ' Calculate MUF for this date
GOSUB DoFlux ' Update SSN or Flux
Month=VAL(EDIT$(1)) ' Get current parameter values
Day=VAL(EDIT$(2))
SSN=VAL(EDIT$(3))
Lat1=VAL(EDIT$(5))
Long1=VAL(EDIT$(6))
Lat2=VAL(EDIT$(7))
Long2=VAL(EDIT$(8))
DoMUF:
CALL <0x2f,0x07>(VARPTR(Rect%(0))) ' Set up graphics area
CALL <0x1e,0x07> (250,10): CALL <0x1e,0x00> (250,280)
CALL <0x20,0x07> (490,280): CALL <0x20,0x00> (490,10)
FOR F=0 TO 30 STEP 10
Y=280-8*F
CALL <0x22,0x07> (230,Y+5): PRINT USING "##"; F;
CALL <0x1f,0x07> (250,Y): CALL <0x1f,0x00> (255,Y)
CALL <0x21,0x07> (490,Y): CALL <0x21,0x00> (485,Y)
NEXT F
CALL <0x19,0x07> (215,70): PRINT "MUF";
CALL <0x1a,0x07> (210,85): PRINT "(MHz)"
FOR H=0 TO 24 STEP 6
X=250+10*H
CALL <0x22,0x07> (X,280): CALL <0x22,0x00> (X,275)
CALL <0x24,0x07> (X-9,297): PRINT USING "##"; H;
NEXT H
CALL <0x1a,0x07> (395,300): PRINT "UT";
Mflag=0 ' Signals start of line segment
FOR Hour=0 TO 24
CALL MUFFER (Lat1,Long1,Lat2,Long2,Month,Day,Hour,SSN,MUF)
MUF(Hour)=MUF
IF MUF<34 THEN ' Plot the MUF value
IF Mflag=0 THEN
CALL <0x1c,0x07> (250+10*Hour,280-8*MUF)
Mflag=1
ELSE
CALL <0x1c,0x07> (250+10*Hour,280-8*MUF)
END IF
ELSE
Mflag=0
END IF
NEXT Hour
CALL <0x43,0x07> (10,155) ' Print table of MUF values
PRINT "Hour MUF Hour MUF";
FOR H=0 TO 11
CALL <0x15,0x07> (10,170+12*H)
PRINT USING " ## ###.# ## ###.#"; H,MUF(H),H+12,MUF(H+12);
NEXT H
RETURN
SetUp: ' Init the program
<0x9e6a81,0x07>(4)
<0x9e6a97,0x07>(9)
WINDOW 2,,(186,22)-(509,336),3 ' Help window
<0x40,0x07> 5,1,"More",(100,290)-(150,310),1
<0x40,0x07> 6,1,"OK",(200,290)-(250,310),1
WINDOW 1,,(1,21)-(511,339),3 ' Main window
WINDOW OUTPUT 1
MENU 1,0,1,"Help" ' Setup menu
MENU 1,1,1,"Help"
MENU 1,2,0,"-"
MENU 1,3,1,"Quit"
D$=DATE$ ' Setup edit fields
CALL <0x1a,0x07> (10,23): PRINT "Date:";
EDIT FIELD 1,MID$(D$,1,2),(60,10)-(80,25),1
CALL <0x16,0x07> (93,23): PRINT "/";
EDIT FIELD 2,MID$(D$,4,2),(110,10)-(130,25),1
CALL <0x19,0x07> (10,48): PRINT "SS#:";
<0x40,0x07> 2,2,"",(55,35)-(70,50),3
Bflag=2
EDIT FIELD 3,"100",(80,35)-(110,50),1
CALL <0x1a,0x07> (10,73): PRINT "Flux:";
<0x40,0x07> 3,1,"",(55,60)-(70,75),3
EDIT FIELD 4,"",(80,60)-(110,75),1
CALL <0x19,0x07> (60,95): PRINT "Lat";
CALL <0x19,0x07> (100,95): PRINT "Long";
CALL <0x1a,0x07> (10,112): PRINT "Xmtr:";
EDIT FIELD 5, "42.3",(50,100)-(90,115),1
EDIT FIELD 6, "77.8",(95,100)-(135,115),1
CALL <0x1a,0x07> (10,132): PRINT "Rcvr:";
EDIT FIELD 7, "43.5",(50,120)-(90,135),1
EDIT FIELD 8, "72.8",(95,120)-(135,135),1
<0x40,0x07> 1,1,"Go",(150,10)-(180,30),1
<0x40,0x07> 4,1,"Quit",(150,40)-(180,60),1
Efield=1
Rect%(0)=1: Rect%(1)=200: Rect%(2)=300: Rect%(3)=495
DoFlux: ' Updates SSN and Flux values
IF Bflag=2 THEN
S=VAL(EDIT$(3))
F=FNFlux(S)
EDIT FIELD 4,STR$(CINT(F)),(80,60)-(110,75),1
ELSEIF Bflag=3 THEN
F=VAL(EDIT$(4))
S=FNSS(F)
EDIT FIELD 3,STR$(CINT(S)),(80,35)-(110,50),1
END IF
X=FRE("")
EDIT FIELD Efield
RETURN
END
SUB MUFFER (Lata,Longa,Latb,Longb,Month,Day,Hour,SSN,MUF) STATIC
' A literal translation of the MINIMUF 3.5 code.
One=0.99999
Pi=4*ATN(1): HalfPi=Pi/2: TwoPi=2*Pi: Rads=Pi/180
Lat1=Rads*Lata: SLat1=SIN(Lat1): CLat1=COS(Lat1)
Lat2=Rads*Latb: SLat2=SIN(Lat2): CLat2=COS(Lat2)
Long2=Rads*Longb: DLong12=Rads*(Longa-Longb)
CR12=SLat1*SLat2+CLat1*CLat2*COS(DLong12)
IF ABS(CR12)>One THEN CR12=One*SGN(CR12)
SR12=SQR(1-CR12*CR12)
R12=HalfPi-ATN(CR12/SR12)
K6=1.59*R12
IF K6<=1 THEN
K6=1
K5=1
ELSE
K5=0.5
END IF
M9=2.5*R12*K5
IF M9<HalfPi THEN M9=SIN(M9) :ELSE M9=1
M9=(1+2.5*M9*SQR(M9))*(1+SSN/250)
M9=M9*(1+0.1*(1-SGN(Lat1)*SGN(Lat2)))
ElongSun=0.0172*(10+(Month-1)*30.4+Day)
DecSun=0.409*COS(ElongSun)
HA0Sun=12+0.13*(SIN(ElongSun)+1.2*SIN(2*ElongSun))
MUF=100
A=(SLat1-SLat2*CR12)/(CLat2*SR12)
FOR K1=1/(2*K6) TO 1-1/(2*K6) STEP 0.9999-1/K6
B=R12*K1
C=SLat2*COS(B)+CLat2*SIN(B)*A
Lat0=ATN(C/SQR(1-C*C))
D=(COS(B)-C*SLat2)/(CLat2*SQR(1-C*C))
IF ABS(D>One) THEN D=One*SGN(D)
Long0=Long2+SGN(SIN(DLong12))*(HalfPi-ATN(D/SQR(1-D*D)))
IF Long0<0 THEN Long0=Long0+TwoPi
IF Long0>=TwoPi THEN Long0=Long0-TwoPi
K8=3.82*Long0+HA0Sun
IF K8>24 THEN K8=K8-24
C0=COS(Lat0+DecSun)
IF C0<=-0.26 THEN K9=0: G0=0: GOTO L1770
K9=(-0.26+SIN(DecSun)*SIN(Lat0))/(COS(DecSun)*COS(Lat0)+0.001)
K9=12-ATN(K9/SQR(ABS(1-K9*K9)))*7.63944
T=K8-K9/2
IF T<0 THEN T=T+24
T4=K8+K9/2
IF T4>24 THEN T4=T4-24
C0=ABS(C0)
T9=9.7*C0^9.6
IF T9<0.1 THEN T9=0.1
G8=Pi*T9/K9
IF T4<T THEN L1680
IF (Hour-T)*(T4-Hour)>0 THEN L1690 :ELSE L1820
L1680:
IF (Hour-T4)*(T-Hour)>0 THEN L1820
L1690:
IF T>Hour THEN T6=Hour+24 :ELSE T6=Hour
G9=Pi*(T6-T)/K9
G0=SIN(G9)+G8*(EXP((T-T6)/T9)-COS(G9))
G7=G8*(EXP(-K9/T9)+1)*EXP((K9-24)/2)
IF G0<G7 THEN G0=G7
GOTO L1770
L1820:
T6=Hour+12*(1+SGN(T4-Hour))*SGN(ABS(T4-Hour))
G0=G8*(EXP(-K9/T9)+1)*EXP((T4-T6)/2)
L1770:
G0=C0*G0/(1+G8*G8)
G2=M9*SQR(6+58*SQR(G0))
G2=G2*(1-0.1*EXP((K9-24)/3))
G2=G2
G2=G2*(1-0.1*(1+SGN(ABS(SIN(Lat0))-COS(Lat0))))
IF MUF>G2 THEN MUF=G2
NEXT K1
END SUB
SUB Helper (Page%) STATIC ' Prints help screens
CLS
ON Page% GOTO Page1,Page2
EXIT SUB
Page1:
PRINT " MacMiniMUF"
PRINT " by"
PRINT " J. Scott Weaver, KA2OVS"
PRINT " 5 Sayles St., Alfred, NY 14802"
PRINT " 7/19/87
PRINT " (All commercial rights reserved.)"
PRINT
PRINT "MacMiniMUF is a F-region propagation model useful"
PRINT "from 2 to 50 MHz and ranges from 250 to 6000"
PRINT "miles. MacMiniMUF is based on MINIMUF 3.5. (See:"
PRINT "Rose, R. B., K6GKU, 'MINIMUF: A Simplified MUF-"
PRINT "Prediction Program for Microcomputers', QST, Dec."
PRINT "1982, pp. 36-38.)"
PRINT
PRINT "Note: the Basic Compiler and Runtime Modules"
PRINT "are Copyright1986 by the Microsoft Corporation."
EXIT SUB
Page2:
PRINT " MacMiniMUF"
PRINT
PRINT "Instructions:"
PRINT "Use mouse and keyboard to enter data into fields."
PRINT "TAB advances to next field. Radio buttons select"
PRINT "solar input as Sunspot number or 2800MHz flux."
PRINT "GO button or Return key starts calculations. QUIT"
PRINT "(button or menu choice) exits program."
PRINT
PRINT "Limits: -90 <= Lat <= 90 -360 < Long < 360"
PRINT
PRINT "Warning: No input error checking is done!"
END SUB